home *** CD-ROM | disk | FTP | other *** search
/ Kompuutteri Kaikille K-CD 2002 #1 / K-CD_2002-01.iso / Delphi / INSTALL / program files / Borland / Delphi6 / Demos / ActiveX / ShellExt / PureContextMenu.pas < prev    next >
Pascal/Delphi Source File  |  2001-05-22  |  19KB  |  619 lines
  1. unit PureContextMenu;
  2.  
  3. interface
  4.  
  5. uses
  6.   ActiveX;
  7.  
  8. function DllGetClassObject(const CLSID: TCLSID; const IID: TIID;
  9.   var Obj: Pointer): HResult; stdcall;
  10. function DllCanUnloadNow: HResult; stdcall;
  11. function DllRegisterServer: HResult; stdcall;
  12. function DllUnregisterServer: HResult; stdcall;
  13.  
  14. implementation
  15.  
  16. uses
  17.   Windows, SysUtils, ShellAPI, ShlObj;
  18.  
  19. const
  20.   IID_IUnknown: TIID = '{00000000-0000-0000-C000-000000000046}';
  21.  
  22. type
  23.   IUnknown    = ^PIUnknownMT;
  24.   PIUnknownMT = ^TIUnknownMT;
  25.   TIUnknownMT = packed record  { IUnknown method table }
  26.     QueryInterface: function (const Self: IUnknown;
  27.       const IID: TIID; var Obj: Pointer): HResult; stdcall;
  28.     AddRef:         function (const Self: IUnknown): Integer; stdcall;
  29.     Release:        function (const Self: IUnknown): Integer; stdcall;
  30.   end;
  31.  
  32.  
  33. const
  34.   IID_IClassFactory: TIID = '{00000001-0000-0000-C000-000000000046}';
  35.  
  36. type
  37.   IClassFactory    = ^PIClassFactoryMT;
  38.   PIClassFactoryMT = ^TIClassFactoryMT;
  39.   TIClassFactoryMT = packed record  { IClassFactory method table }
  40.     case Integer of
  41.       0: (
  42.         { IUnknown methods }
  43.         QueryInterface: function (const Self: IClassFactory;
  44.           const IID: TIID; var Obj: Pointer): HResult; stdcall;
  45.         AddRef:         function (const Self: IClassFactory): Integer; stdcall;
  46.         Release:        function (const Self: IClassFactory): Integer; stdcall;
  47.         { IClassFactory methods }
  48.         CreateInstance: function (const Self: IClassFactory;
  49.           const UnkOuter: IUnknown; const IID: TIID;
  50.           var Obj: Pointer): HResult; stdcall;
  51.         LockServer:     function (const Self: IClassFactory;
  52.           fLock: Bool): HResult; stdcall;);
  53.  
  54.       1: (IUnknownMT: TIUnknownMT);
  55.   end;
  56.  
  57.  
  58. type
  59.   IDataObject    = ^PIDataObjectMT;
  60.   PIDataObjectMT = ^TIDataObjectMT;
  61.   TIDataObjectMT = packed record  { IDataObject method table }
  62.     case Integer of
  63.       0: (
  64.         { IUnknown methods }
  65.         QueryInterface: function (const Self: IClassFactory;
  66.           const IID: TIID; var Obj: Pointer): HResult; stdcall;
  67.         AddRef:         function (const Self: IClassFactory): Integer; stdcall;
  68.         Release:        function (const Self: IClassFactory): Integer; stdcall;
  69.         { IDataObject methods }
  70.         GetData: function (const Self: IDataObject; const formatetcIn: TFormatEtc;
  71.           var medium: TStgMedium): HResult; stdcall;
  72.         // This is cheating here, a bit.  The remaining methods in IDataObject
  73.         // are unused, so some work can be saved by defining only what is used.
  74.         // And that's O.K. since the method table is identical to this point.
  75.         {!!!--------------------------------------------------------------------
  76.         GetDataHere: function (const Self: IDataObject;
  77.           const formatetc: TFormatEtc; var medium: TStgMedium): HResult; stdcall;
  78.         QueryGetData: function (const Self: IDataObject;
  79.           const formatetc: TFormatEtc): HResult; stdcall;
  80.         GetCanonicalFormatEtc: function (const Self: IDataObject;
  81.           const formatetc: TFormatEtc; var formatetcOut: TFormatEtc): HResult;
  82.           stdcall;
  83.         SetData: function (const Self: IDataObject; const formatetc: TFormatEtc;
  84.           var medium: TStgMedium; fRelease: BOOL): HResult; stdcall;
  85.         EnumFormatEtc: function (const Self: IDataObject; dwDirection: Longint;
  86.           var enumFormatEtc: IEnumFormatEtc): HResult; stdcall;
  87.         DAdvise: function (const Self: IDataObject; const formatetc: TFormatEtc;
  88.           advf: Longint; const advSink: IAdviseSink; var dwConnection: Longint):
  89.           HResult; stdcall;
  90.         DUnadvise: function (const Self: IDataObject; dwConnection: Longint):
  91.           HResult; stdcall;
  92.         EnumDAdvise: function (const Self: IDataObject;
  93.           var enumAdvise: IEnumStatData): HResult; stdcall;
  94.         --------------------------------------------------------------------!!!}
  95.         );
  96.  
  97.       1: (IUnknownMT: TIUnknownMT);
  98.   end;
  99.  
  100.  
  101. const
  102.   IID_IShellExtInit: TIID = '{000214E8-0000-0000-C000-000000000046}';
  103.  
  104. type
  105.   IShellExtInit    = ^PIShellExtInitMT;
  106.   PIShellExtInitMT = ^TIShellExtInitMT;
  107.   TIShellExtInitMT = packed record   { IShellExtInit method table }
  108.     case Integer of
  109.       0: (
  110.         { IUnknown methods }
  111.         QueryInterface: function (const Self: IShellExtInit;
  112.           const IID: TIID; var Obj: Pointer): HResult; stdcall;
  113.         AddRef:         function (const Self: IShellExtInit): Integer; stdcall;
  114.         Release:        function (const Self: IShellExtInit): Integer; stdcall;
  115.         { IShellExtInit methods }
  116.         Initialize: function (const Self: IShellExtInit;
  117.           pidlFolder: PItemIDList; lpdobj: IDataObject; hKeyProgID: HKEY):
  118.           HResult; stdcall;);
  119.  
  120.       1: (IUnknownMT: TIUnknownMT);
  121.   end;
  122.  
  123.  
  124. const
  125.   IID_IContextMenu: TIID = '{000214E4-0000-0000-C000-000000000046}';
  126.  
  127. type
  128.   IContextMenu    = ^PIContextMenuMT;
  129.   PIContextMenuMT = ^TIContextMenuMT;
  130.   TIContextMenuMT = packed record  { IContextMenu method table }
  131.     case Integer of
  132.       0: (
  133.         { IUnknown methods }
  134.         QueryInterface: function (const Self: IContextMenu;
  135.           const IID: TIID; var Obj: Pointer): HResult; stdcall;
  136.         AddRef:         function (const Self: IContextMenu): Integer; stdcall;
  137.         Release:        function (const Self: IContextMenu): Integer; stdcall;
  138.         { IContextMenu methods }
  139.         QueryContextMenu: function (const Self: IContextMenu; Menu: HMENU;
  140.           indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult; stdcall;
  141.         InvokeCommand:    function (const Self: IContextMenu;
  142.           var lpici: TCMInvokeCommandInfo): HResult; stdcall;
  143.         GetCommandString: function (const Self: IContextMenu;
  144.           idCmd, uType: UINT; pwReserved: PUINT; pszName: LPSTR;
  145.           cchMax: UINT): HResult; stdcall;);
  146.  
  147.       1: (IUnknownMT: TIUnknownMT);
  148.   end;
  149.  
  150.  
  151. const
  152.   CLSIDString_QuickRegister = '{40E69241-5D1A-11D1-81CB-0020AF3E97A9}';
  153.   CLSIDStr                  = 'CLSID\' + CLSIDString_QuickRegister;
  154.  
  155.   CLSID_QuickRegister: TCLSID = CLSIDString_QuickRegister;
  156.  
  157.  
  158. type
  159.   PClassFactory = ^TClassFactory;
  160.   TClassFactory = PIClassFactoryMT;
  161.  
  162.   PContextMenu = ^TContextMenu;
  163.   TContextMenu = record
  164.     CMMTAddr:  PIContextMenuMT;
  165.     SEIMTAddr: PIShellExtInitMT;
  166.     RefCount:  Integer;
  167.     FileName:  String;
  168.   end;
  169.  
  170. var
  171.   ClassFactoryMT: TIClassFactoryMT;
  172.   ContextMenuMT:  TIContextMenuMT;
  173.   ShellExtInitMT: TIShellExtInitMT;
  174.  
  175.   ClassFactory: TClassFactory;
  176.  
  177.   ServerLockCount: Integer = 0;
  178.  
  179. { COM Runtime support }
  180.  
  181. function DllGetClassObject(const CLSID: TCLSID; const IID: TIID;
  182.   var Obj: Pointer): HResult; stdcall;
  183. begin
  184.   // Validate the output address.
  185.   if @Obj = nil then begin
  186.     Result := E_POINTER;
  187.     Exit
  188.   end;
  189.  
  190.   // Assume failure.
  191.   Obj := nil;
  192.   Result := CLASS_E_CLASSNOTAVAILABLE;
  193.  
  194.   if IsEqualCLSID(CLSID, CLSID_QuickRegister) then
  195.     Result := ClassFactory^.QueryInterface(@ClassFactory, IID, Obj)
  196. end;
  197.  
  198. function DllCanUnloadNow: HResult; stdcall;
  199. begin
  200.   if (ServerLockCount <> 0) then
  201.     Result := S_FALSE
  202.   else
  203.     Result := S_OK
  204. end;
  205.  
  206. function DllRegisterServer: HResult; stdcall;
  207. var
  208.   FileName: array [0..MAX_PATH] of Char;
  209.   RootKey: HKey;
  210.  
  211.   procedure CreateKey(const Key, ValueName, Value: string);
  212.   var
  213.     Handle: HKey;
  214.     Res,
  215.     Disposition: Integer;
  216.   begin
  217.     Res := RegCreateKeyEx(RootKey, PChar(Key), 0, '',
  218.       REG_OPTION_NON_VOLATILE, KEY_READ or KEY_WRITE, nil, Handle, @Disposition);
  219.     if Res = 0 then begin
  220.       Res := RegSetValueEx(Handle, PChar(ValueName), 0,
  221.         REG_SZ, PChar(Value), Length(Value) + 1);
  222.       RegCloseKey(Handle)
  223.     end;
  224.     if Res <> 0 then
  225.       raise Exception.Create('Error updating registry')
  226.   end;
  227.  
  228. begin
  229.   try
  230.     RootKey := HKEY_CLASSES_ROOT;
  231.     CreateKey(CLSIDStr, '', 'Quick Register Context Menu Shell Extension');
  232.  
  233.     GetModuleFileName(HInstance, FileName, SizeOf(FileName));
  234.     CreateKey(CLSIDStr + '\InprocServer32', '', FileName);
  235.     CreateKey(CLSIDStr + '\InprocServer32', 'ThreadingModel', 'Apartment');
  236.  
  237.     CreateKey('dllfile\shellex', '', '');
  238.     CreateKey('dllfile\shellex\ContextMenuHandlers', '', '');
  239.     CreateKey('dllfile\shellex\ContextMenuHandlers\QuickRegister', '',
  240.       CLSIDString_QuickRegister);
  241.  
  242.     RootKey := HKEY_LOCAL_MACHINE;
  243.     CreateKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions', '', '');
  244.     CreateKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved',
  245.       CLSIDString_QuickRegister, 'Quick Register Context Menu Shell Extension');
  246.     Result := S_OK
  247.   except
  248.     DllUnregisterServer;
  249.     Result := SELFREG_E_CLASS
  250.   end
  251. end;
  252.  
  253. function DllUnregisterServer: HResult; stdcall;
  254.  
  255.   procedure DeleteKey(const Key: string);
  256.   begin
  257.     RegDeleteKey(HKEY_CLASSES_ROOT, PChar(Key))
  258.   end;
  259.  
  260. begin
  261.   DeleteKey('dllfile\shellex\ContextMenuHandlers\QuickRegister');
  262.   DeleteKey('dllfile\shellex\ContextMenuHandlers');
  263.   DeleteKey('dllfile\shellex');
  264.   DeleteKey(CLSIDStr + '\InprocServer32');
  265.   DeleteKey(CLSIDStr);
  266.   Result := S_OK
  267. end;
  268.  
  269.  
  270. { IClassFactory - IUnknown methods}
  271.  
  272. function ClassFactory_QueryInterface(const Self: IUnknown; const IID: TIID;
  273.   var Obj: Pointer): HResult; stdcall;
  274. begin
  275.   // Validate the output address.
  276.   if @Obj = nil then begin
  277.     Result := E_POINTER;
  278.     Exit
  279.   end;
  280.  
  281.   // Assume failure.
  282.   Obj := nil;
  283.   Result := E_NOINTERFACE;
  284.  
  285.   // Check for supported interfaces.
  286.   if IsEqualIID(IID, IID_IUnknown) or
  287.      IsEqualIID(IID, IID_IClassFactory) then begin
  288.     // Return the requested interface and AddRef.
  289.     Obj := Self;
  290.     IUnknown(Obj)^^.AddRef(Obj);
  291.     Result := S_OK
  292.   end
  293. end;
  294.  
  295. function ClassFactory_AddRef(const Self: IUnknown): Integer; stdcall;
  296. begin
  297.   InterlockedIncrement(ServerLockCount);
  298.   Result := 2
  299. end;
  300.  
  301. function ClassFactory_Release(const Self: IUnknown): Integer; stdcall;
  302. begin
  303.   InterlockedDecrement(ServerLockCount);
  304.   Result := 1
  305. end;
  306.  
  307. { IClassFactory - IClassFactory methods}
  308.  
  309. function ClassFactory_CreateInstance(const Self: IClassFactory;
  310.   const UnkOuter: IUnknown; const IID: TIID;
  311.   var Obj: Pointer): HResult; stdcall;
  312. var
  313.   pcm: PContextMenu;
  314. begin
  315.   // Validate the output address.
  316.   if @Obj = nil then begin
  317.     Result := E_POINTER;
  318.     Exit
  319.   end;
  320.  
  321.   // Assume failure.
  322.   Obj := nil;
  323.  
  324.   // This object does not support aggregation.
  325.   if Assigned(UnkOuter) then begin
  326.     Result := CLASS_E_NOAGGREGATION;
  327.     Exit
  328.   end;
  329.  
  330.   pcm := nil;
  331.   try
  332.     // Construct a ContextMenu object.
  333.     New(pcm);
  334.     FillChar(pcm^, SizeOf(pcm^), 0);
  335.     with pcm^do begin
  336.       CMMTAddr  := @ContextMenuMT;
  337.       SEIMTAddr := @ShellExtInitMT;
  338.       Result := CMMTAddr^.QueryInterface(@CMMTAddr, IID, Obj);
  339.       if Succeeded(Result) then
  340.         InterlockedIncrement(ServerLockCount)
  341.       else
  342.         Dispose(pcm)
  343.     end
  344.   except
  345.     on E: EOutOfMemory do
  346.       Result := E_OUTOFMEMORY
  347.     else begin
  348.       if Assigned(pcm) then
  349.         Dispose(pcm);
  350.       Result := E_FAIL
  351.     end
  352.   end
  353. end;
  354.  
  355. function ClassFactory_LockServer(const Self: IClassFactory; fLock: Bool): HResult;
  356.   stdcall;
  357. begin
  358.   if fLock then
  359.     InterlockedIncrement(ServerLockCount)
  360.   else
  361.     InterlockedDecrement(ServerLockCount);
  362.   Result := S_OK
  363. end;
  364.  
  365.  
  366. { IContextMenu - IUnknown methods}
  367.  
  368. function ContextMenu_QueryInterface(const Self: IUnknown; const IID: TIID;
  369.   var Obj: Pointer): HResult; stdcall;
  370. begin
  371.   // Validate the output address.
  372.   if @Obj = nil then begin
  373.     Result := E_POINTER;
  374.     Exit
  375.   end;
  376.  
  377.   // Assume failure.
  378.   Obj := nil;
  379.   Result := E_NOINTERFACE;
  380.  
  381.   // Check for supported interfaces.
  382.   if IsEqualIID(IID, IID_IUnknown) or
  383.      IsEqualIID(IID, IID_IContextMenu) or
  384.      IsEqualIID(IID, IID_IShellExtInit) then
  385.     // Return the requested interface and AddRef.
  386.     with PContextMenu(Self)^ do begin
  387.       if IsEqualIID(IID, IID_IShellExtInit) then
  388.         Obj := @SEIMTAddr
  389.       else
  390.         Obj := @CMMTAddr;
  391.  
  392.       IUnknown(Obj)^^.AddRef(Obj);
  393.       Result := S_OK
  394.     end
  395. end;
  396.  
  397. function ContextMenu_AddRef(const Self: IUnknown): Integer; stdcall;
  398. begin
  399.   with PContextMenu(Self)^ do
  400.     Result := InterlockedIncrement(RefCount)
  401. end;
  402.  
  403. function ContextMenu_Release(const Self: IUnknown): Integer; stdcall;
  404. begin
  405.   with PContextMenu(Self)^ do begin
  406.     Result := InterlockedDecrement(RefCount);
  407.     if (Result = 0) then begin
  408.       Dispose(PContextMenu(Self));
  409.       InterlockedDecrement(ServerLockCount)
  410.     end
  411.   end
  412. end;
  413.  
  414. { IContextMenu - IContextMenu methods}
  415.  
  416. function ContextMenu_QueryContextMenu(const Self: IContextMenu; Menu: HMENU;
  417.   indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult; stdcall;
  418. begin
  419.   Result := MakeResult(SEVERITY_SUCCESS, FACILITY_NULL, 0);
  420.   if ((uFlags and $0000000F) = CMF_NORMAL) or
  421.      ((uFlags and CMF_EXPLORE) <> 0) then begin
  422.  
  423.     InsertMenu(Menu, indexMenu, MF_SEPARATOR or MF_BYPOSITION, 0, nil);
  424.     InsertMenu(Menu, indexMenu + 1, MF_STRING or MF_BYPOSITION, idCmdFirst,
  425.       'Register');
  426.     InsertMenu(Menu, indexMenu + 2, MF_STRING or MF_BYPOSITION, idCmdFirst + 1,
  427.       'Unregister');
  428.     InsertMenu(Menu, indexMenu + 3, MF_SEPARATOR or MF_BYPOSITION, 0, nil);
  429.  
  430.     Result := MakeResult(SEVERITY_SUCCESS, FACILITY_NULL, 2)
  431.   end
  432. end;
  433.  
  434. function ContextMenu_InvokeCommand(const Self: IContextMenu;
  435.   var lpici: TCMInvokeCommandInfo): HResult; stdcall;
  436. const
  437.   ProcNames: array [0..1] of PChar =
  438.     ('DllRegisterServer', 'DllUnregisterServer');
  439. var
  440.   pcm: PContextMenu absolute Self;
  441.   Cmd: Word;
  442.  
  443.   procedure RegisterCOMServer;
  444.   var
  445.     Handle:  THandle;
  446.     RegProc: function: HResult; stdcall;
  447.     hr:      HResult;
  448.   begin
  449.     Handle := LoadLibrary(PChar(pcm^.FileName));
  450.     if Handle = 0 then
  451.       raise Exception.CreateFmt('%s: %s',
  452.         [SysErrorMessage(GetLastError), pcm^.FileName]);
  453.     try
  454.       RegProc := GetProcAddress(Handle, ProcNames[Cmd]);
  455.       if Assigned(RegProc) then begin
  456.         hr := RegProc;
  457.         if Failed(hr) then
  458.           raise Exception.Create(
  459.             ProcNames[Cmd] + ' in ' + pcm^.FileName + ' failed.')
  460.       end
  461.       else
  462.         RaiseLastWin32Error
  463.     finally
  464.       FreeLibrary(Handle)
  465.     end
  466.   end;
  467.  
  468. begin
  469.   Result := E_INVALIDARG;
  470.   Cmd := LoWord(Integer(lpici.lpVerb));
  471.   if (HiWord(Integer(lpici.lpVerb)) <> 0) or (not Cmd in [0..1]) then
  472.     Exit;
  473.  
  474.   Result := E_FAIL;
  475.   try
  476.     RegisterCOMServer;
  477.     MessageBox(lpici.hwnd,
  478.       PChar(ProcNames[Cmd] + ' in ' + pcm^.FileName + ' succeeded.'),
  479.       'Quick Register', MB_ICONINFORMATION or MB_OK);
  480.     Result := S_OK
  481.   except
  482.     on E: Exception do
  483.       MessageBox(lpici.hWnd, PChar(E.Message), 'Quick Register - Error',
  484.         MB_ICONERROR or MB_OK);
  485.   end
  486. end;
  487.  
  488. function ContextMenu_GetCommandString(const Self: IContextMenu;
  489.   idCmd, uType: UINT; pwReserved: PUINT; pszName: LPSTR;
  490.           cchMax: UINT): HResult; stdcall;
  491. const
  492.   RegStr: PChar = 'Register this COM/ActiveX server.';
  493.   UnRegStr: PChar = 'Unregister this COM/ActiveX server.';
  494. begin
  495.   Result := S_OK;
  496.   if uType = GCS_HELPTEXT then
  497.     case idCmd of
  498.       0: StrCopy(pszName, RegStr);
  499.       1: StrCopy(pszName, UnRegStr)
  500.       else
  501.         Result := E_INVALIDARG
  502.     end
  503. end;
  504.  
  505.  
  506. { IShellExtInit - IUnknown methods }
  507.  
  508. function ShellExtInit_QueryInterface(const Self: IUnknown; const IID: TIID;
  509.   var Obj: Pointer): HResult; stdcall;
  510. var
  511.   TrueSelf: IContextMenu;
  512. begin
  513.   // Fix up the pointer to the IContextMenu interface.
  514.   TrueSelf := IContextMenu(Self);
  515.   Dec(TrueSelf);
  516.  
  517.   // Delegate.
  518.   Result := TrueSelf^^.QueryInterface(TrueSelf, IID, Obj)
  519. end;
  520.  
  521. function ShellExtInit_AddRef(const Self: IUnknown): Integer; stdcall;
  522. var
  523.   TrueSelf: IContextMenu;
  524. begin
  525.   // Fix up the pointer to the IContextMenu interface.
  526.   TrueSelf := IContextMenu(Self);
  527.   Dec(TrueSelf);
  528.  
  529.   // Delegate.
  530.   Result := TrueSelf^^.AddRef(TrueSelf)
  531. end;
  532.  
  533. function ShellExtInit_Release(const Self: IUnknown): Integer; stdcall;
  534. var
  535.   TrueSelf: IContextMenu;
  536. begin
  537.   // Fix up the pointer to the IContextMenu interface.
  538.   TrueSelf := IContextMenu(Self);
  539.   Dec(TrueSelf);
  540.  
  541.   // Delegate.
  542.   Result := TrueSelf^^.Release(TrueSelf)
  543. end;
  544.  
  545.  
  546. { IShellExtInit - IShellExtInit.Initialize}
  547.  
  548. function ShellExtInit_Initialize(const Self: IShellExtInit;
  549.   pidlFolder: PItemIDList; lpdobj: IDataObject; hKeyProgID: HKEY): HResult;
  550.   stdcall;
  551. var
  552.   pcm:         PContextMenu;
  553.   ContextMenu: IContextMenu absolute pcm;
  554.   FormatETC:   TFormatEtc;
  555.   StgMedium:   TStgMedium;
  556.   szFile:      array [0..MAX_PATH] of Char;
  557. begin
  558.   if not Assigned(lpdobj) then begin
  559.     Result := E_INVALIDARG;
  560.     Exit
  561.   end;
  562.  
  563.   // Fix up the pointer to the actual ContextMenu "object".
  564.   ContextMenu := IContextMenu(Self);
  565.   Dec(ContextMenu);
  566.  
  567.   with FormatETC do begin
  568.     cfFormat := CF_HDROP;
  569.     ptd      := nil;
  570.     dwAspect := DVASPECT_CONTENT;
  571.     lindex   := -1;
  572.     tymed    := TYMED_HGLOBAL
  573.   end;
  574.   Result := E_FAIL;
  575.   if Succeeded(lpdobj^^.GetData(lpdobj, FormatETC, StgMedium)) and
  576.      (DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0) = 1) then begin
  577.     DragQueryFile(StgMedium.hGlobal, 0, szFile, SizeOf(szFile));
  578.     pcm^.FileName := szFile;
  579.     ReleaseStgMedium(StgMedium);
  580.     Result := S_OK
  581.   end
  582. end;
  583.  
  584.  
  585. initialization
  586.   // Setup the method table for each interface that is implemented.
  587.   with ClassFactoryMT, IUnknownMT do begin
  588.     QueryInterface := ClassFactory_QueryInterface;
  589.     AddRef         := ClassFactory_AddRef;
  590.     Release        := ClassFactory_Release;
  591.  
  592.     CreateInstance := ClassFactory_CreateInstance;
  593.     LockServer     := ClassFactory_LockServer
  594.   end;
  595.  
  596.   with ContextMenuMT, IUnknownMT do begin
  597.     QueryInterface := ContextMenu_QueryInterface;
  598.     AddRef         := ContextMenu_AddRef;
  599.     Release        := ContextMenu_Release;
  600.  
  601.     QueryContextMenu := ContextMenu_QueryContextMenu;
  602.     InvokeCommand    := ContextMenu_InvokeCommand;
  603.     GetCommandString := ContextMenu_GetCommandString
  604.   end;
  605.  
  606.   with ShellExtInitMT, IUnknownMT do begin
  607.     QueryInterface := ShellExtInit_QueryInterface;
  608.     AddRef         := ShellExtInit_AddRef;
  609.     Release        := ShellExtInit_Release;
  610.  
  611.     Initialize     := ShellExtInit_Initialize
  612.   end;
  613.  
  614.   // "Instantiate" the classfactory.
  615.   ClassFactory := @ClassFactoryMT;
  616.  
  617.   DisableThreadLibraryCalls(hInstance)
  618. end.
  619.